perm filename DRAW.OLD[DRW,LCS] blob
sn#449474 filedate 1979-06-10 generic text, type T, neo UTF8
00100 C***** FOLLOWING IS FILE 'DRAW.CMD' **********
00200 C*** DRAW[DRW,LCS],MSSIO[NEW,LCS],CB[DRW,LCS]
00300 C*** ,DRAWSM[DRW,LCS],DPYIT[DRW,LCS],DREDIT[DRW,LCS],FILLER[DRW,LCS]
00400 C*** ,CURSOR[MSS,LCS],SUBSLM[DRW,LCS]
00500
00600 C 'G' OR <CR> = GET. 'A'=ADD TO COMBINED FILE.
00700 C PC=PLOT PX=XGP(→PLOT.BIN) PXS,PCS=PLOT SMOOTHED CONTURE
00800 C PXZ,PCZ=PLOT SMOOTHED CONTURE AND FILL IT.
00900 C IN DRAW SECTION: J=JUMP(INVIS. VECT.)
01000 C F=JUMP AND BEGIN FILL SECTION. FX=EXIT AND FILL ALL.
01100 C SINGLE ITEM IS RESTRICTED TO 350 WDS. 10 ITEMS OR 350 WDS PER FILE.
01200 C 'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
01300 COMMON /RC/MCLEF(400),IST(4000)
01400 COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
01500 COMMON/ZN/SCLEF(400,2),DDD /ED/KED,NEXT,NN,NX,NY,J
01600 COMMON XX(100),G(100),NJ,QF(512),RF(512),S(100),K
01700 DIMENSION JCLEF(10),KCLEF(10),NMLST(10),JST(1)
01800 COMMON/NFF/NF(513) /LL/LL /RZ/RSZ,IPLT,RJB,CENTR
01900 COMMON/LETS/LETS(12)
02000 EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST(1490)),(NM,IXRX)
02100 1 ,(GRID,IST(4000)),(KCLEF,IST(1500))
02200 1 ,(NMLST,IST(1510)),(JST,IST(500))
02300 1,(LETS(1),LG),(LETS(2),LS),(LETS(3),LM),(LETS(4),LD)
02400 1,(LETS(5),LR),(LETS(6),LP),(LETS(7),LA),(LETS(8),LF)
02500 1,(LETS(9),LE),(LETS(10),LZ),(LETS(11),LQ),(LETS(12),LC)
02600 DATA LETS/'G','S','M','D','R','P','A','F','E','Z',
02700 1'Q','C'/
02800 DATA RJB/-20./,CENTR/-26./
02900 RSZ=0
03000 39 MCLEF(1)=0
03100 MM=0
03200 IPLT=0
03300 IPLTX=-1
03400 K=1
03500 91 TYPE 100
03600 55 FORMAT(I,2F)
03700 50 FORMAT(3A1)
03800 XSZ=RSZ
03900 ACCEPT 55,J,RSZ,GRID
04000 IF(RSZ.EQ.0)RSZ=XSZ
04100 MORE=-1
04200 REREAD 50,N,JC,JS
04300 IF(RSZ.EQ.0)RSZ=9.0
04400 IF(GRID.NE.0.AND.N.NE.'P')CALL GRIDS
04500 DO 191 K=1,12
04600 C G S M D R P A F E Z
04700 191 IF(LETS(K).EQ.N)GO TO(30,30,32,33,32,30,36,79,38,39,
04800 1 56)K
04900 C Q
05000 IF(N.NE.' ')TYPE 391
05100 GO TO 50
05200 391 FORMAT(' UNKNOWN COMMAND'/)
05300 C PXS,PCS=SMOOTH ONLY; PXZ,PCZ=SMOOTH AND FILL
05400 C TO SAVE SIZE FACTOR WHEN REDRAWING.
05500 1 IF(N.EQ.'V')CALL CNVT
05600 C V=CONVERT FROM OLD FORMAT TO NEW.
05700 C FOR ROTATION OR MOVING AND DISTORTING ENTIRE PICTURE
05800 C FILLS IT.
05900 C 'Q' MAKES CURRENT DPY IN BACKGROUND ON POG2
06000
06100 33 IF(JS.NE.'L')GO TO 38
06200 N='Z'
06300 C DEL=DELETE FROM COMB. FILE. (JS='L')
06400 GO TO 36
06500 38 KED=N
06600 MM=MCLEF(1)
06700 IF(MM.NE.0)GO TO 92
06800 C ADD TO DRAWING?
06900 GO TO 3
07000
07100 56 CALL POG2
07200 CALL RDRAW(2,MCLEF(1),MCLEF)
07300 CALL DPYOUT(2)
07400 CALL POG1
07500 GO TO 91
07600 36 CALL CMBN
07700 CCC GO TO 111
07750 GO TO 91
07800 32 CALL SHIFT(MCLEF(2),MCLEF(1),N)
07900 J=1
08000 JC=0
08100 GO TO 333
08200 291 FORMAT(A2,A5)
08300 30 REREAD 291,NM,NM
08400 IF(JC.EQ.LM)NM=' '
08500 IF(NM.NE.' ')GO TO 293
08600 130 TYPE 41
08700 IF(JC.EQ.'M')GO TO 194
08800 IF(N.EQ.'S')GO TO 194
08900 MCLEF(1)=0
09000 MM=0
09100 IPLTX=-1
09200 K=1
09300 194 IF(JC.EQ.'M')MORE=0
09400 JQ=JC
09500 JC=0
09600 JM=1
09700 IF(MCLEF(1).EQ.0)GO TO 193
09800 JM=MCLEF(1)+1
09900 193 ACCEPT 10,NM,PASS
10000 IF(NM.EQ.' ')NM=LASTNM
10100 IF(NM.EQ.' ')GO TO 91
10200 IF(NM.EQ.'B'.OR.NM.EQ.'99')GO TO 91
10300 C 'B' OR '99' WILL BACKUP
10400 293 IF(N.NE.'S')LASTNM=NM
10500 IF(N.EQ.'S')GO TO 40
10600 IF(LOOKF(NM).EQ.0)GO TO 130
10700 C 'FAIL' ROUTINE TO CHECK ON LOOKUP
10800 CALL RDSAV(KCLEF,NMLST,M,NM,JST,-1)
10900 C -1=READ
11000 C CAN'T USE 'GM' WITH 'COMBINED' FILE.
11100 J=1
11200 IF(KCLEF(2).EQ.0)GO TO 290
11300 TYPE 1100
11400 ACCEPT 55,J
11500 J=J+1
11600 C ITEMS ARE NUMBERED 0 THROUGH 9 (10 ITEMS).
11700 IF(J.GT.10)GO TO 191
11800 290 IC=KCLEF(J)+JST(KCLEF(J))-1
11900 CCC TYPE 110,IC
12000 IF(IC.GT.350)TYPE 1110
12100 60 JZ=1
12200 IF(MORE.EQ.0)JZ=JM
12300 L=KCLEF(J)-1
12400 M=JST(L+1)+JZ-1
12500 IF(MORE.NE.0)GO TO 161
12600 M=M-1
12700 L=L+1
12800 161 DO 61 K=JZ,M
12900 L=L+1
13000 61 MCLEF(K)=JST(L)
13100 MCLEF(1)=M
13200 1100 FORMAT(' ITEM NUM?'/)
13300 700 FORMAT(' RESET X-Y POS. ',$)
13400 555 FORMAT(2F)
13500 7 IF(MORE)GO TO 70
13600 DO 771 K=2,JM-1
13700 771 IF(MCLEF(K).GE.200000000)GO TO 772
13800 GO TO 70
13900 C PUTS FILLER TO END
14000 C MOVES OUTLINE UP FRONT
14100 772 M=MCLEF(1)
14200 DO 773 L=K,JM
14300 M=M+1
14400 773 MCLEF(M)=MCLEF(L)
14500 K=JM-K
14600 1774 DO 774 L=JM,M
14700 774 MCLEF(L-K)=MCLEF(L)
14800 GO TO 3
14900
15000 70 IF(N.NE.'P')GO TO 3
15100 IXRX=-1
15200 IF(JQ.NE.'X')IXRX=0
15300 C 0=SEND IT TO CALCOMP
15400 TYPE 700
15500 ACCEPT 555,X,Y
15600 IF(X.NE.0)RJB=X/RSZ
15700 IF(Y.NE.0)CENTR=Y/RSZ
15800 C TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
15900 IF(IPLTX)CALL PLOTS(0)
16000 C DO I NEED THIS?
16100 IF(GRID.GT.0)CALL GRIDS
16200 IPLTX=0
16300 IPLT=-1
16400 3 IF(N.NE.'D')MM=0
16500 C RESET IF NOT GOING TO DRAWIT
16600 333 IF(N.EQ.'P')GO TO 337
16700 CALL DPYSET(1,IST,4000)
16800 CALL DPYBRT(4)
16900 NIST=IST(2)
17000 IF(N.GE.0)GO TO 337
17100 IF(N.EQ.'G')GO TO 337
17200 IF(N.EQ.'M')GO TO 337
17300 IF(N.NE.'R')GO TO 92
17400 337 IF(JS.EQ.'Z')GO TO 306
17500 IF(JS.NE.'S')GO TO 338
17600 CALL SMOOTH(JS)
17700 GO TO 436
17800 338 IC=-1
17900 MM=1
18000 DO 335 K=2,MCLEF(1)
18100 IF(MCLEF(K).LT.200000000)GO TO 335
18200 IC=K
18300 GO TO 334
18400 C FOR 1ST LOC. OF MCLEF IN FILLER
18500 335 CONTINUE
18600 334 CALL RDRAW(2,MCLEF(1),MCLEF)
18700 CALL DPYOUT(1)
18800 NIST=IST(2)
18900 GO TO 436
19000 C NO FILLER
19100 79 IF(IC)GO TO 91
19200 C IC=-1 IF NO FILLER WAS REQUESTED WHILE DRAWING.
19300 JZ=N
19400 KK=0
19500 IF(JC.NE.'S')GO TO 206
19600 C TYPE 'FS' TO FILL AND SMOOTH
19700 306 CALL SMOOTH(0)
19800 C SMOOTHS AND FILLS
19900 GO TO 436
20000 206 RR=RSZ
20100 DO 205 J=IC,MCLEF(1)
20200 CALL UNPACK(J,M,N,MCLEF)
20300 KK=KK+1
20400 NF(KK)=0
20500 IF(LL.GE.100000000)NF(KK)=3
20600 QF(KK)=(M+RJB)*RR
20700 205 RF(KK)=(N+CENTR)*RR
20800 NF(1)=KK
20900 CALL FILLQ(QF,RF,NF)
21000 436 IF(JZ.EQ.'P')CALL PLOT(0,0,3)
21100 GO TO 91
21200
21300 66 TYPE 666,NM
21400 GO TO 91
21500 666 FORMAT(' MORE THAN ONE ITEM IN FILE ',A5/)
21600 336 FORMAT(' SMOOTH? ',$)
21700 10 FORMAT(A5,F)
21800 5 FORMAT(12I)
21900 100 FORMAT(' G=GET, GM=GET MORE, S=SAVE, D=DRAW, M=MOVE, R=ROTATE,'/'
22000 1 P=PLOT, PX=XGP, A=ADD TO SAVED FILE
22100 1, DEL=DEL. FROM FILE, Q=BACKGROUND, Z=ZERO DRAWING'/
22200 1' F=FILL, E=EDIT, N1=SIZE, N2=1=GRID '/)
22300 C N1=20 TO CHANGE SHAPE
22400
22500 92 IST(2)=NIST
22600 CALL DRAWIT
22700 N=0
22800 GO TO 3
22900
23000 403 FORMAT(' WRITE OVER ',A5,'.DMD? ',$)
23100 41 FORMAT(' TYPE FILE NAME'/)
23200 C SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
23300 40 IF(LOOKF(NM).EQ.0)GO TO 402
23400 TYPE 403,NM
23500 ACCEPT 50,K
23600 IF(K.EQ.'N')GO TO 191
23700 402 NMLST(1)=NM
23800 JCLEF(1)=1
23900 DO 1111 K=2,10
24000 JCLEF(K)=0
24100 1111 NMLST(K)=' '
24200 CALL RDSAV(JCLEF,NMLST,MCLEF(1),NM,MCLEF,0)
24300 NQ=MCLEF(1)
24400 CC111 TYPE 110,NQ
24500 IF(NQ.GT.350)TYPE 1110
24600 GO TO 91
24700 CC120 FORMAT(' 9999 1 ',I4,' 0 0 0 0 0 0 0 0')
24800 110 FORMAT(' TOTAL WDS=',I3)
24900 1110 FORMAT(' ********************************',/
25000 1 ' ***** WARNING - LIMIT=350 ******',/
25100 1 ' ********************************')
25200 END